home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
PROGMISC
/
ALGOL.LZH
/
IPICDUMP.SP
< prev
next >
Wrap
Text File
|
1986-07-09
|
5KB
|
152 lines
BEGIN
{ This program dumps a picture file to the screen. It is
in a format created by hardware by Chorus Data Systems
6 Continental Boulevard in Merrimack,New Hampshire. }
INTEGER POINTER, { This variable points into row of video data. }
Picture, { This variable holds the file number of data file. }
Row_length, {Usually 320 or 112 bytes,two pixels per byte. }
SCALE; { Scale factor of data being plotted. }
INTEGER ARRAY Colors(8); { This array holds the real pixel
values in brightness order. }
STRING ROW; { This variable holds a row of pixel intensities. }
PROCEDURE Advance_file_pointer;
BEGIN
{ This procedure reads 256 bytes which places the file
pointer at the beginning of the data for the picture. }
ROW := INPUT$(255,#Picture); { Read 255 characters not used. }
ROW := INPUT$(1,#Picture); {Read one more character. }
END
PROCEDURE Get_row_of_data;
BEGIN
{ This procedure gets a row of data and puts it into the
STRING ROW. }
IF Row_length<=255 THEN ROW := INPUT$(Row_length,#Picture);
ELSE
BEGIN
ROW := INPUT$(255,#Picture)
+ INPUT$(Row_length-255,#Picture);
END
POINTER := 1; { Read the pixels and set pointer to one. }
END
INTEGER Pixel_value; { Result of PROCEDURE Get_pixel_value. }
PROCEDURE Get_pixel_value;
BEGIN
{ This PROCEDURE will extract a 4 bit pixel intensity and
scale it. }
Pixel_value := ASC(MID$(ROW,INT((POINTER-1)/2+1),1));
IF ( POINTER AND 1 )=0 THEN
BEGIN
Pixel_value := INT((Pixel_value AND 15)/SCALE);
RETURN;
END
ELSE
BEGIN
Pixel_value := INT((Pixel_value \ 16)/SCALE);
RETURN;
END
END
PROCEDURE Setscreen;
BEGIN
{ This PROCEDURE sets the screen from the file of data. }
INTEGER X, { Loop variable X }
Y, { Loop variable Y }
PIXEL; { Pixel value to be plotted. }
SCREEN 9; { Set screen 9 High resolution EGA mode 640x350 }
FOR Y := 0 STEP 1 UNTIL 199 DO
BEGIN
Get_row_of_data;
FOR X := 0 STEP 1 UNTIL (Row_length*2.)-1 DO
BEGIN
Get_pixel_value; PIXEL := Pixel_value;
{ Make sure pixel value is between 0 and 7. }
IF PIXEL>7 THEN PIXEL := 7; IF PIXEL<0 THEN PIXEL := 0;
PSET(X,Y),Colors(PIXEL+1); POINTER := POINTER+1;
END
END
END
{ This is the main program. }
STRING Key; { Holds key value. }
STRING Picture_filename; { Picture file name. }
Picture := 1; {Set picture file number. }
{ Set the proper brightness levels. }
Colors(1) := 0; Colors(2) := 1; Colors(3) := 4; Colors(4) := 5;
Colors(5) := 2; Colors(6) := 3; Colors(7) := 6; Colors(8) := 7;
Start:
ONERRGOTO Error_in_row_length;
Get_row_length:INPUT( 'Enter row length in bytes 320,111 or 112:',
Row_length );
IF Row_length<>320 AND Row_length<>112 AND Row_length<>111
THEN GO Get_row_length;
ONERRGOTO Error_in_scale_factor;
Get_scale_factor:INPUT( 'Enter Scale factor 1-16:',SCALE );
IF SCALE<1 OR SCALE>16 THEN GO Get_scale_factor;
ONERRGOTO Error_in_filename;
Get_filename:
LINEIN( 'Enter picture file name:',Picture_filename);
OPEN( 'I',Picture,Picture_filename); { Open the picture file. }
ONERRGOTO Final_error;
Advance_file_pointer; {Point to 257th character. }
HOME; Setscreen; { Set the video from the data file. }
CLOSE(Picture); {Close the picture file. }
Wait_here:Key:=INKEY$; IF Key='' THEN GO Wait_here;
IF Key='D' THEN
BEGIN
DEFSEG:=57344; BSAVE('PICT.G',0,45000);
DEFSEG:=49152; BSAVE('PICT.B',0,45000);
DEFSEG:=53248; BSAVE('PICT.R',0,45000);
GO Start;
END
ELSE GO Start;
Error_in_row_length:
OUTPUT( 'ERROR,Reenter row length' ); OUTPUT(); RESUME Get_row_length;
Error_in_scale_factor:
OUTPUT( 'ERROR,Reenter scale factor' ); OUTPUT(); RESUME Get_scale_factor;
Error_in_filename:
OUTPUT( 'ERROR,Reenter filename' ); OUTPUT(); RESUME Get_filename;
Final_error:OUTPUT(); OUTPUT('Error:' @ ERR @ 'in line:' @ERL);
RESUME Finish;
Finish:
END